unit uDZOleAuto;

interface

uses
  SysUtils,
  ActiveX;

function CallDispMethod(const disp: IDispatch; _lcid: TLCID;
  const name: WideString; const params: array of const;
  res: PVariant): Boolean;
  
implementation

const
  MAX_DISP_ARGS = 64;

function AssignVariant(var param: TVariantArg; const value: TVarRec): Boolean;
begin
  Result := True;
  with value do
    case VType of
      vtInteger:
        begin
          param.vt := VT_I4;
          param.lVal := VInteger;
        end;
      vtBoolean:
        begin
          param.vt := VT_BOOL;
          param.vbool := VBoolean;
        end;
      vtChar:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := StringToOleStr(VChar);
        end;
      vtExtended:
        begin
          param.vt := VT_R8;
          param.dblVal := VExtended^;
        end;
      vtString:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := StringToOleStr(VString^);
        end;
      vtPointer:
        if VPointer = nil then begin
          param.vt := VT_NULL;
          param.byRef := nil;
        end
        else begin
          param.vt := VT_BYREF;
          param.byRef := VPointer;
        end;
      vtPChar:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := StringToOleStr(StrPas(VPChar));
        end;
      vtObject:
        begin
          param.vt := VT_BYREF;
          param.byRef := VObject;
        end;
      vtClass:
        begin
          param.vt := VT_BYREF;
          param.byRef := VClass;
        end;
      vtWideChar:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := @VWideChar;
        end;
      vtPWideChar:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := VPWideChar;
        end;
      vtAnsiString:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := StringToOleStr(string(VAnsiString));
        end;
      vtCurrency:
        begin
          param.vt := VT_CY;
          param.cyVal := VCurrency^;
        end;
      vtVariant:
        begin
          param.vt := VT_BYREF or VT_VARIANT;
          param.pvarVal := VVariant;
        end;
      vtInterface:
        begin
          param.vt := VT_UNKNOWN or VT_BYREF;
          param.byRef := VInterface;
        end;
      vtWideString:
        begin
          param.vt := VT_BSTR;
          param.bstrVal := VPWideChar;
        end;
      vtInt64:
        begin
          param.vt := VT_I8 or VT_BYREF;
          param.byRef := VInt64;
        end;
    else Result := False;
    end;
end;

function NameToDispID(const disp: IDispatch; const name: WideString;
  _lcid: TLCID; out _dispID: TDispID): Boolean;
begin
  Result := Succeeded(disp.GetIDsOfNames(GUID_NULL, PWideChar(name),
    1, _lcid, @_dispID));
end;

function CallDispMethod(const disp: IDispatch; _lcid: TLCID;
  const name: WideString; const params: array of const;
  res: PVariant): Boolean;
var
  id: TDispID;
  names: array[0..0] of PWideChar;
  dispParams: TDispParams;
  argCnt, i, j: Integer;
  args: array[0..MAX_DISP_ARGS - 1] of TVariantArg;
  exceptionInfo: TExcepInfo;
  argErr: Integer;
  hr: HResult;
begin
  names[0] := PWideChar(name);
  if (Failed(disp.GetIDsOfNames(GUID_NULL, @names, 1, _lcid, @id))) then
  begin
    Result := False;
    Exit;
  end;
  argCnt := Length(params);
  if (argCnt > MAX_DISP_ARGS) then
    argCnt := MAX_DISP_ARGS;
  j := 0;
  for i := Low(params) + argCnt - 1 downto Low(params) do
  begin
    AssignVariant(args[j], params[i]);
    Inc(j);
  end;
  if (argCnt = 0) then
    dispParams.rgvarg := nil
  else
    dispParams.rgvarg := @args;
  dispParams.rgdispidNamedArgs := nil;
  dispParams.cArgs := argCnt;
  dispParams.cNamedArgs := 0;
  if (res <> nil) then
    VarClear(res^);
  try
    hr := disp.Invoke(id, GUID_NULL, _lcid, DISPATCH_METHOD,
      dispParams, res, @exceptionInfo, @argErr);
  except
    if (res <> nil) then
      VarClear(res^);
    Result := False;
    Exit;
  end;
  Result := Succeeded(hr);
end;

end.

